home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / basic2 / pro19 / qbinput.sub < prev    next >
Text File  |  1987-03-08  |  5KB  |  100 lines
  1. 'QBINPUT.SUB - subroutine to build input string in a controlled manner
  2. 'written by l.m. bernbaum
  3. 'Copyright LMB Enterprises,  1986
  4. 'No Charge - use it as you see fit
  5. '
  6. '
  7. 'Either merge this code into your Quikbasic program directly,  or remember to
  8. 'include it via the QB Metacommand REM $INCLUDE: 'QBINPUT.SUB'.
  9. '
  10. 'You call this routine from within a program with the command:
  11. '
  12. 'CALL GETINP(IX,IY,MAXLEN,FILL,GETKEY$,WRAP)
  13. '
  14. 'where   IX       = The line number (between 1 and 23)
  15. '        IY       = The column number (between 1 and (79-MAXLEN))
  16. '        MAXLEN   = The desired length of the string
  17. '        FILL     = The ASCII decimal value of the desired filler in the
  18. '                   input area. Example ASCII 42 = *,  thus a FILL of 42
  19. '                   would create an input area filled with asteriks to
  20. '                   show the user the field length.
  21. '        GETKEY$  = The input string returned to the calling program
  22. '        WRAP     = 1=enable wrapping;anything else reuires a CR to end input
  23. '
  24. SUB GETINP(ix,iy,maxlen,fill,getkey$,wrap) STATIC
  25.         '
  26.         'make sure input string\work string empty
  27.         getkey$="":del$=""
  28.         '
  29.         'locate and print input area with prespecified "filler string"(FILL)
  30.         'at specified input location
  31.         locate ix,iy:print string$(maxlen,fill):locate ix,iy,1
  32.         '
  33.         'loop for required number of characters - set by MAXLEN
  34. inloop: while len(getkey$)<=maxlen-1
  35.           char$=""
  36.           while char$=""                                     'wait for a char
  37.              char$=inkey$                                    'to be entered
  38.           wend
  39.           if asc(char$)=13 then                              'CR terminates
  40.              locate ,,0                                      'turn off  cursor
  41.              goto don                                        'get out of loop
  42.           '
  43.           'screen bad chars first
  44.           '
  45.           elseif asc(char$)<=7 or asc(char$)>=10 and asc(char$)<=12 or_
  46.                  asc(char$)>=14 and asc(char$)<=31 or asc(char$)>=127 then
  47.              locate ix,iy,0:print getkey$                    'ignore key
  48.              locate ix,(iy+(int(len(getkey$)))),1            'reset cursor
  49.           '
  50.           'process a backspace key
  51.           '
  52.           elseif asc(char$)=8 and len(getkey$)>=1 then       'backspace
  53.              del$=left$(getkey$,(len(getkey$)-1))            'delete a char
  54.              getkey$=del$                                    'from work string
  55.              locate ix,iy,0:print getkey$                    'print the new
  56.              locate ix,(iy+(int(len(getkey$))))              'string and then
  57.              print string$((maxlen-len(getkey$)),fill)       'new input filler
  58.              locate ix,(iy+(int(len(getkey$)))),1            'reset cursor pos
  59.           '
  60.           'ignore tab key
  61.           '
  62.           elseif asc(char$)=9 then                           'beep on tab
  63.              locate ix,iy,0:print getkey$;chr$(7)            'key;ignore tab
  64.              locate ix,(iy+(int(len(getkey$)))),1            'reset cursor
  65.           '
  66.           ' at last an acceptable character
  67.           '
  68.           else getkey$=getkey$+char$                         'accept input
  69.              locate ix,iy,0:print getkey$                    'character and
  70.              locate ix,(iy+(int(len(getkey$)))),1            'add to string
  71.           end if
  72.        wend                 'loop until maxlen reached or c/r issued
  73. getret: if wrap=1 then                                      'wrap around
  74.            goto don                                         'enabled = 1
  75.         end if
  76.         char$=""                                            'on wrap around
  77.         while char$=""                                      'don't wait for
  78.             char$=inkey$                                    'return key.
  79.         wend
  80.        if asc(char$)=8 and len(getkey$)=maxlen then         'in non-wrap mode
  81.              del$=left$(getkey$,(len(getkey$)-1))           'check for a
  82.              getkey$=del$                                   'backspace before
  83.              locate ix,iy,0:print getkey$                     'CR;delete last
  84.              locate ix,(iy+(int(len(getkey$))))               'char, print new
  85.              print string$((maxlen-len(getkey$)),fill)      'input string
  86.              locate ix,(iy+(int(len(getkey$)))),1             'pad filler,locate
  87.              goto inloop                                    'cursor and go back
  88.        end if                                               'to input loop.
  89.        if asc(char$)<>13 then
  90.           char$=""
  91.           goto getret
  92.        else
  93.           goto don
  94.        end if
  95. don:   'exit point for subroutine
  96. wrap=0 'disable wrap unless asked for specifically by each subprog call
  97. EXIT SUB
  98. END SUB
  99. 
  100.